/* This file is part of IsoType.
 *
 * IsoType is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * IsoType is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with IsoType.  If not, see <http://www.gnu.org/licenses/>.
 */

%{
  open Ast
%}

%token LPAREN RPAREN LBRACK RBRACK
%token STAR EQ
%token ARROW
%token COLON SEMICOLON DOT COMMA
%token OR
%token EOF

%token OF
%token AND
%token EXCEPTION
%token MODULE SIG END
%token MUTABLE
%token TYPE
%token VAL

%token <string> TVAR
%token <string list> QID
%token <string> ID
%token <string> CID

%start main
%type <Ast.entity list> main

%%

main
: entity_list EOF { $1 }
;

atomic_type
: qname { Ref ([], $1) }
| atomic_type qname { Ref ([$1], $2) }
| LPAREN type_expr COMMA type_comma_ne_list RPAREN qname { Ref ($2 :: $4, $6) }
| TVAR { Var $1 }
| LPAREN type_expr RPAREN { $2 }
;

type_star_ne_list
: atomic_type { [$1] }
| atomic_type STAR type_star_ne_list { $1 :: $3 }
;

tuple_type
: type_star_ne_list {
  match $1 with
      [typ] -> typ
    | typs -> Tuple typs
}
;

arrow_type
: tuple_type { $1 }
| tuple_type ARROW arrow_type { Arrow ($1, $3) }
;

type_expr
: arrow_type { $1 }
;

qname 
: qid { $1 }
;

qid
: ID { Ast.Id $1 }
| CID DOT qid { Ast.Segment ($1, $3) }
| CID LPAREN CID RPAREN DOT qid { Ast.Functor ($1, $3, $6) }
;

type_comma_ne_list 
: type_expr { [$1] } 
| type_expr COMMA type_comma_ne_list { $1 :: $3 }
;

type_body
: type_expr { Alias $1 }
| constr_ne_list { Algebraic $1 }
| LBRACK field_list RBRACK { Record $2 }
;

constr_ne_list 
: constr { [$1] }
| constr OR constr_ne_list { $1 :: $3 }
;

constr 
: CID { Constructor ($1, []) }
| CID OF type_star_ne_list { Constructor ($1, $3) }
;

field_list
: { [] }
| field_ne_list { $1 }
;

field_ne_list 
: field { [$1] }
| field field_ne_list { $1 :: $2 }
;

field 
: mutable_opt ID COLON type_expr SEMICOLON { Field ($2, $4) } 
;

mutable_opt
: { }
| MUTABLE { }
;

fparams
: { [] }
| TVAR { [$1] } 
| LPAREN tvar_comma_ne_list RPAREN { $2 }
;

tvar_comma_ne_list 
: TVAR { [$1] }
| TVAR COMMA tvar_comma_ne_list { $1 :: $3 }
;

type_decl 
: TYPE type_def_ne_list { Type $2 }
;

type_def_ne_list
: type_def { [$1] }
| type_def AND type_def_ne_list { $1 :: $3 }
;

type_def
: fparams ID { ($1, $2, Abstract) }
| fparams ID EQ type_body { ($1, $2, $4) }
;

value_decl
: VAL ID COLON type_expr { Value ($2, $4) }
;

exception_decl
: EXCEPTION constr { Exception $2 }
;

mid
: CID { $1 }
;

module_decl
: MODULE mid COLON SIG entity_list END { Module ($2, $5) }
;

entity
: value_decl { $1 }
| type_decl { $1 }
| exception_decl { $1 }
| module_decl { $1 }
;

entity_list
: { [] }
| entity_ne_list { $1 }
;

entity_ne_list 
: entity { [$1] }
| entity entity_ne_list { $1 :: $2 }
;

